home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / EGAVGA.SWG / 0010_FADING.PAS.pas < prev    next >
Pascal/Delphi Source File  |  1993-05-28  |  9KB  |  298 lines
  1. {
  2. Eirik Milch Pedersen
  3.  
  4. > I too, would appreciate the source for fading colours in 16 colour text
  5. > mode on a VGA, i've tried my hand at it but can't work out a decent
  6. > algoritm, i've been using int 10h to set a block of colour regs for speed
  7. > but can't seem to work out how to fade the colours!
  8.  
  9. I replyed to the author of the first fade-question, but I might as well post
  10. my code to the public. This is a little demo I made in TP60 for fading form a
  11. palette to another. So techincal you can fade from anything to anything. :-)
  12. The routine should be fast enough for most computers, but if you start to
  13. see 'snow' on the screen try to reduce the number of colors that are faded.
  14. }
  15.  
  16. {$G+}
  17. uses
  18.   crt;
  19.  
  20. type
  21.   ColorType = array[0..255] of record
  22.                                  R, G, B : byte;
  23.                                end;
  24.  
  25. var
  26.   Colors,
  27.   White,
  28.   Black   : ColorType;
  29.  
  30. procedure SetMode(Mode : word); assembler;
  31. asm
  32.   mov  ax, Mode
  33.   int  010h
  34. end;
  35.  
  36. procedure MakeColors(ColorArray : pointer); assembler;
  37. label
  38.   RLoop, GLoop, BLoop;
  39. asm
  40.   les  di, ColorArray
  41.  
  42.   mov  cx, 85
  43.   xor  al, al
  44.  RLoop:
  45.   mov  byte ptr es:[di+0], al
  46.   mov  byte ptr es:[di+1], 0
  47.   mov  byte ptr es:[di+2], 0
  48.   add  di, 3
  49.   inc  al
  50.   and  al, 03Fh
  51.   loop Rloop
  52.  
  53.   mov  cx, 85
  54.   xor  al, al
  55.  GLoop:
  56.   mov  byte ptr es:[di+0], 0
  57.   mov  byte ptr es:[di+1], al
  58.   mov  byte ptr es:[di+2], 0
  59.   add  di, 3
  60.   inc  al
  61.   and  al, 03Fh
  62.   loop Gloop
  63.  
  64.   mov  cx, 86
  65.   xor  al, al
  66.  BLoop:
  67.   mov  byte ptr es:[di+0], 0
  68.   mov  byte ptr es:[di+1], 0
  69.   mov  byte ptr es:[di+2], al
  70.   add  di, 3
  71.   inc  al
  72.   and  al, 03Fh
  73.   loop Bloop
  74. end;
  75.  
  76. procedure DrawBars; assembler;
  77. label
  78.   LineLoop, PixelLoop;
  79. asm
  80.   mov  ax, 0A000h
  81.   mov  es, ax
  82.   xor  di, di
  83.  
  84.   mov  cx, 200
  85.  LineLoop:
  86.   xor  al, al
  87.   push cx
  88.   mov  cx, 320
  89.  PixelLoop:
  90.   stosb
  91.   inc  al
  92.   loop PixelLoop
  93.  
  94.   pop  cx
  95.   loop LineLoop
  96. end;
  97.  
  98. procedure UpdateColorsSlow(ColorBuffer : pointer); assembler;
  99. label
  100.   ColorLoop;
  101. asm
  102.   push ds
  103.  
  104.   lds  si, ColorBuffer
  105.   mov  cx, 3*256
  106.  
  107.   mov  dx, 03C8h
  108.   xor  al, al
  109.   out  dx, al
  110.   inc  dx
  111.  ColorLoop:                         { here is the substitute that }
  112.   lodsb                      { goes round the problem.     }
  113.   out  dx, al
  114.   loop ColorLoop
  115.  
  116.   pop  ds
  117. end;
  118.  
  119. procedure UpdateColorsFast(ColorBuffer : pointer); assembler;
  120. asm
  121.   push ds
  122.  
  123.   lds  si, ColorBuffer
  124.   mov  cx, 3*256
  125.  
  126.   mov  dx, 03C8h
  127.   xor  al, al
  128.   out  dx, al
  129.   inc  dx
  130.  
  131.   rep  outsb              { here is the cause of the problem. }
  132.  
  133.   pop  ds
  134. end;
  135.  
  136.  
  137. procedure FadeColors(FromColors, ToColors : Pointer;
  138.                      StartCol, NoColors, NoSteps : byte); assembler;
  139. label
  140.   Start, DummyPalette, NoColorsX3,
  141.   DummySub, StepLoop, ColorLoop,
  142.         SubLoop, RetrLoop1, RetrLoop2, Over1, Over2;
  143. asm
  144.         jmp        Start
  145.  DummyPalette:
  146.         db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  147.         db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  148.         db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  149.         db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  150.         db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  151.         db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  152.         db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  153.         db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  154.         db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  155.         db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  156.         db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  157.         db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  158.         db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  159.         db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  160.         db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  161.         db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  162.         db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  163.         db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  164.         db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  165.         db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  166.         db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  167.         db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  168.         db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  169.         db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  170.  DummySub:
  171.         db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  172.         db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  173.         db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  174.         db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  175.         db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  176.         db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  177.         db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  178.         db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  179.         db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  180.         db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  181.         db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  182.         db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  183.         db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  184.         db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  185.         db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  186.         db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  187.         db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  188.         db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  189.         db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  190.         db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  191.         db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  192.         db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  193.         db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  194.   db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  195.  NoColorsX3 :
  196.   dw          0
  197.  Start:
  198.         push ds
  199.  
  200.         lds         si, ToColors
  201.   les         di, FromColors
  202.   xor  ch, ch
  203.   mov         cl, NoColors
  204.   shl         cx, 1
  205.   add         cl, NoColors
  206.   adc  ch, 0
  207.   mov         word ptr cs:[NoColorsX3], cx
  208.   mov         bx, 0
  209.   push di
  210.  SubLoop:
  211.         lodsb
  212.         sub         al, byte ptr es:di
  213.         mov         byte ptr cs:[DummySub+bx], al
  214.   inc         di
  215.   inc         bx
  216.         loop SubLoop
  217.   pop         di
  218.  
  219.   push cs
  220.   pop         ds
  221.         mov         dh, 0
  222.   mov  dl, NoSteps
  223.  StepLoop:
  224.   push di
  225.   mov         cx, word ptr cs:[NoColorsX3]
  226.   mov         bx, 0
  227.  ColorLoop:
  228.   xor         ah, ah
  229.         mov         al, byte ptr cs:[DummySub+bx]
  230.   or         al, al
  231.   jns         over1
  232.   neg         al
  233.  over1:
  234.   mul         dh
  235.   div         dl
  236.   cmp  byte ptr cs:[DummySub+bx], 0
  237.   jge         over2
  238.   neg         al
  239.  over2:
  240.   mov         ah, byte ptr es:[di]
  241.   add         ah, al
  242.   mov         byte ptr cs:[DummyPalette+bx], ah
  243.   inc         bx
  244.   inc         di
  245.   loop ColorLoop
  246.  
  247.   push dx
  248.   mov  si, offset DummyPalette
  249.   mov  cx, word ptr cs:[NoColorsX3]
  250.  
  251.   mov  dx, 03DAh
  252.  retrloop1:
  253.   in          al, dx
  254.   test al, 8
  255.   jnz  retrloop1
  256.  retrloop2:
  257.   in          al, dx
  258.   test al, 8
  259.   jz   retrloop2
  260.  
  261.   mov  dx, 03C8h
  262.   mov  al, StartCol
  263.   out  dx, al
  264.   inc  dx
  265.   rep         outsb
  266.  
  267.   pop         dx
  268.  
  269.   pop         di
  270.   inc         dh
  271.   cmp         dh, dl
  272.   jbe         StepLoop
  273.  
  274.   pop         ds
  275. end;
  276.  
  277.  
  278.  
  279. begin
  280.   ClrScr;
  281.   MakeColors(@Colors);
  282.   FillChar(Black, 256 * 3, 0);
  283.   FillChar(White, 256 * 3, 63);
  284.  
  285.   SetMode($13);
  286.   UpdateColorsSlow(@Black);
  287.   DrawBars;
  288.  
  289.   REPEAT
  290.     FadeColors(@Black, @Colors, 0, 255, 100);
  291.     FadeColors(@Colors, @White, 0, 255, 100);
  292.     FadeColors(@White, @Colors, 0, 255, 100);
  293.     FadeColors(@Colors, @Black, 0, 255, 100);
  294.   UNTIL keyPressed;
  295.  
  296.   SetMode($3);
  297. END.
  298.